home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / tbbs / prgsourc.zip / FLAGS.ZIP / FLAG.PRG < prev    next >
Text File  |  1996-03-06  |  33KB  |  1,304 lines
  1. * abcdefgijhkmnopqrstuvwxyz - l
  2. **************************************************
  3. *                     GLOBAL
  4. **************************************************
  5. *
  6. *      a = SELECT VFlags
  7. *      e = SELECT Flags
  8. *              ***
  9. *  flags = .DBF name
  10. * vflags = .DBF name
  11. *   user = .NDX name
  12. *    pik = .NDX name
  13. *    usr = field from flags, user name (30 char)
  14. *    flg = field from flags, flag string (70 char)
  15. *    vis = field from flags, vis/invis .T./.F. (logical)
  16. *    reg = field from flags, reg/not .T./.F. (logical)
  17. *    age = field from flags, of age/not .T./.F. (logical)
  18. *    ysn = field from flags, yes/no .T./.F. (logical)
  19. *  pfile = field from Vflags, file/identifier (8 char)
  20. *   flen = field from Vflags, length of flag (1 num)
  21. *   fpos = field from Vflags, position of flag (2 num)
  22. *   plen = field from Vflags, lines in pick list (5 num)
  23. * pwidth = field from Vflags, length of pick list lines (2 num)
  24. *   fscr = .FMT file
  25. *              ***
  26. *      b = background color
  27. *      h = highlite color
  28. *      n = normal color
  29. *              ***
  30. *      c = command
  31. *      f = flg string holder
  32. *     f# = f1-f?, file name holder
  33. *     y1 = top
  34. *     x1 = left
  35. *     y2 = bottom
  36. *     x2 = right
  37. *     t = file handle for .TIL file
  38. *     p = file handle for pick list file
  39. *     k = InKey result
  40. *  line = last read line, any file
  41. *     o = .T./.F. temporary in MAIN
  42. *     x = return from Gyx, extra temporary counter
  43. *     y = return from Gyx, extra temporary local
  44. *     z = code returned from file operations
  45. *
  46. **************************************************
  47. *  TEMPORARY LOCAL  -  d,g,i,j,m,q,r,s,u,v,w
  48. **************************************************
  49. *                   PROCEDURES
  50. **************************************************
  51. *
  52. *   Clr = Clear area
  53. *   Dat = Get Date
  54. *    Er = Error routine for ON ERROR
  55. *   Err = Error routine for user errors
  56. *    Gc = Get color
  57. *   Gyx = read y,x1 from file
  58. *   Pic = Pick list
  59. *   Vew = View profiles(s)
  60. *    Yn = Yes/no
  61. *
  62. **************************************************
  63.  
  64. SET FORMAT TO fscr NOCLEAR
  65. SET INTENSITY OFF
  66. SET ESCAPE OFF
  67. ON ERROR DO Er
  68.  
  69. o = .F.
  70. STORE Space(1) TO b,d,f,g,h,k,m,n,q,r,s,u,w
  71. STORE 0 TO y1,x1,y2,x2,i,j,v,x,y,bd
  72.  
  73. USE ail INDEX ails
  74. f1 = LTrim(SubStr(OptData(), At(Chr(38)+Chr(38), OptData())+2))
  75.  
  76. SEEK f1
  77. IF blocked
  78.    TYPE blocked.txt
  79.    k = InKey(60)
  80.    QUIT
  81. ELSE
  82.    CLOSE DATABASES
  83.    f1 = Homepath() + RTrim(f1) + ".AIL"
  84. ENDIF
  85.  
  86.  
  87. SELECT a
  88. USE vflags INDEX pik
  89.  
  90. SELECT e
  91. USE flags INDEX user
  92. SEEK UName()
  93. IF .NOT. Found()
  94.    APPEND BLANK
  95.    REPLACE usr WITH UName()
  96.    f = Replicate(Chr(46),96)
  97.    REPLACE flg WITH f
  98. ENDIF
  99.  
  100. m = fMaxLen()                        && m= max buffer size
  101. IF m > 4096
  102.    v = 1024
  103. ELSE
  104.    IF m > 1024                       && max buffer size =m
  105.       v = 512
  106.    ENDIF
  107. ENDIF
  108.  
  109. FOPEN t (f1) 10 v
  110.  
  111. DO WHILE .T.
  112.    SET COLOR TO W+/N
  113.    SELECT e
  114.    FLREAD t z line
  115.    line = RTrim(CRTrim(line))
  116.    IF Len(line) = 0
  117.       LOOP
  118.    ENDIF
  119.    
  120.    IF ":" $ line
  121.      m = At(":",line)                         && m= Position of ":"
  122.      c = SubStr(line,1,m-1)
  123.    ELSE
  124.      LOOP
  125.    ENDIF
  126.    
  127.    IF Upper(c) = "A"
  128.       line = SubStr(line,m+1)
  129.       m = At("=",line)
  130.       f = SubStr(line,1,m-1)
  131.       q = Upper(SubStr(line,m+1))
  132.       g = Val(SubStr(f,1,1))                  && g= Auth string#
  133.       s = Val(SubStr(f,2))
  134.       m = UAuth(g)
  135.       m = Stuff(m,s,1,q)
  136.       d = UlReplace(Uauth,g,m)                && Auth string# =g
  137.       LOOP
  138.    ENDIF
  139.  
  140.    IF Upper(c) = "IF"
  141.       line = SubStr(line,m+1)
  142.       DO CASE
  143.          CASE "+" $ line 
  144.               DO Gfld WITH 1,o
  145.          
  146.          CASE "-" $ line 
  147.               DO Gfld WITH 2,o
  148.          
  149.          CASE "=" $ line 
  150.               m = At("=",line)
  151.               SELECT a
  152.               SEEK SubStr(line,1,m-1)
  153.               SELECT e
  154.               IF SubStr(flg,a->fpos,a->flen) = SubStr(line,m+1)
  155.                  o = .T.
  156.               ELSE
  157.                  o = .F.
  158.               ENDIF
  159.          CASE "<" $ line 
  160.               m = At("<",line)
  161.               SELECT a
  162.               SEEK SubStr(line,1,m-1)
  163.               SELECT e
  164.               q = SubStr(flg,a->fpos,1)          && q= user's flag value
  165.               s = SubStr(line,m+1,1)             && s= flag value read
  166.               o = .T.
  167.               DO WHILE .T.
  168.                   IF  a->flen = 1
  169.                       IF Asc(q) <= Asc(s)
  170.                          o = .F.
  171.                          EXIT
  172.                       ENDIF
  173.                   ELSE
  174.                       IF Asc(q) < Asc(s)
  175.                          o = .F.
  176.                          EXIT
  177.                       ELSE
  178.                          IF Asc(q) > Asc(s)
  179.                             EXIT
  180.                          ENDIF
  181.                       ENDIF
  182.                       q = SubStr(flg,a->fpos+1,1)   &&  q= user's flag value
  183.                       s = SubStr(line,m+2,1)        &&  s= flag value read
  184.                       IF Asc(q) <= Asc(s)
  185.                          o = .F.
  186.                          EXIT
  187.                       ENDIF
  188.                   ENDIF
  189.               ENDDO
  190.          CASE ">" $ line 
  191.               m = At(">",line)
  192.               SELECT a
  193.               SEEK SubStr(line,1,m-1)
  194.               SELECT e
  195.               q = SubStr(flg,a->fpos,1)          && q= user's flag value
  196.               s = SubStr(line,m+1,1)             && s= flag value read
  197.               o = .T.
  198.               DO WHILE .T.
  199.                   IF  a->flen = 1
  200.                       IF Asc(q) >= Asc(s)
  201.                          o = .F.
  202.                          EXIT
  203.                       ENDIF
  204.                   ELSE
  205.                       IF Asc(q) > Asc(s)
  206.                          o = .F.
  207.                          EXIT
  208.                       ELSE
  209.                          IF Asc(q) < Asc(s)
  210.                             EXIT
  211.                          ENDIF
  212.                       ENDIF
  213.                       q = SubStr(flg,a->fpos+1,1)   &&  q= user's flag value
  214.                       s = SubStr(line,m+2,1)        &&  s= flag value read
  215.                       IF Asc(q) >= Asc(s)
  216.                          o = .F.
  217.                          EXIT
  218.                       ENDIF
  219.                   ENDIF
  220.               ENDDO
  221.       ENDCASE
  222.       IF .NOT. o
  223.          FLFIND t z "ELSE:" 1
  224.       ENDIF
  225.       LOOP
  226.    ENDIF
  227.    
  228.    IF Upper(c) = "ELSE"
  229.       IF o 
  230.          FLFIND t z "ENDIF:" 1
  231.       ENDIF
  232.       LOOP
  233.    ENDIF
  234.    
  235.    IF Upper(c) = "IFDATE"
  236.       line = SubStr(line,m+1)
  237.       DO CASE
  238.          CASE "<" $ line 
  239.               s = 1
  240.               m = At("<",line)
  241.          CASE ">" $ line 
  242.               s = 2
  243.               m = At(">",line)
  244.          CASE "=" $ line 
  245.               s = 2
  246.               m = At("=",line)
  247.       ENDCASE        
  248.       d = SubStr(line,1,m-1)
  249.       q = SubStr(line,1,m+1)
  250.       SELECT a
  251.       SEEK d
  252.       SELECT e
  253.       w = SubStr(flg,a->fpos+2,1)
  254.       w = 254 - Asc(w)
  255.       IF w < 10
  256.          w = "0" + Str(w)
  257.       ELSE 
  258.          w = Str(w)
  259.       ENDIF
  260.       d = SubStr(flg,a->fpos+1,1)
  261.       d = 254 - Asc(d)
  262.       IF d < 10
  263.          d = "0" + Str(d)
  264.       ELSE 
  265.          d = Str(d)
  266.       ENDIF
  267.       i = SubStr(flg,a->fpos,1)
  268.       i = 254 - Asc(d)
  269.       i = 254 - Asc(i)
  270.       IF i < 10
  271.          i = "0" + Str(i)
  272.       ELSE 
  273.          i = Str(i)
  274.       ENDIF
  275.       i = Str(i)
  276.       d = d + "/" + i + "/" + w
  277.       d = CtoD(d)
  278.       q = CtoD(d)
  279.       o = .F.
  280.       DO CASE 
  281.          CASE s = 1
  282.               IF d < q
  283.                  o = .T.
  284.               ENDIF
  285.          CASE s = 2
  286.               IF d > q
  287.                  o = .T.
  288.               ENDIF
  289.          CASE s = 3
  290.               IF d = q
  291.                  o = .T.
  292.               ENDIF
  293.       ENDCASE
  294.       IF .NOT. o
  295.          FLFIND t z "ELSE:" 1
  296.       ENDIF
  297.       LOOP
  298.    ENDIF
  299.    
  300.    IF Upper(c) = "ENDIF"
  301.       o = .F.
  302.       LOOP
  303.    ENDIF
  304.  
  305.    IF Upper(c) = "SHOW"
  306.       line = SubStr(line,m+1)
  307.       q = At("=",line)                        && q=
  308.       f1 = Homepath() + "TEXT\" + SubStr(line,1,q-1) + ".TXT"
  309.       s = Val(SubStr(line,q+1))
  310.       IF s > 255 
  311.          s = 255
  312.       ENDIF
  313.       TYPE (f1)
  314.       IF s = 0
  315.          LOOP
  316.       ELSE
  317.          k = InKey(s)
  318.       ENDIF
  319.       LOOP
  320.    ENDIF
  321.    
  322.    IF Upper(c) = "FLAG"
  323.       line = SubStr(line,m+1)
  324.       q = At("=",line)                        && q=
  325.       s = Val(SubStr(line,1,q-1))             && s=
  326.       d = SubStr(line,1,q+1)                  && d=,=q
  327.       f = flg
  328.       f = Stuff(f,s,Len(d),d)                 && =d,=s
  329.       REPLACE flg WITH f
  330.       LOOP
  331.    ENDIF
  332.    
  333.    IF (c) = "+"
  334.       line = SubStr(line,m+1)
  335.       DO Cfld WITH 1
  336.       LOOP
  337.    ENDIF
  338.    
  339.    IF (c) = "-"
  340.       line = SubStr(line,m+1)
  341.       DO Cfld WITH 2
  342.       LOOP
  343.    ENDIF
  344.    
  345.    IF Upper(c) = "VIEW"
  346.       q = SubStr(line,m+1)
  347.       DO Vew
  348.       LOOP
  349.    ENDIF
  350.    
  351.    IF Upper(c) = "CLEAR"
  352.       q = SubStr(line,m)
  353.       IF Upper(q) = ":SCREEN"
  354.          SET COLOR TO N/N
  355.          @ 0,0 CLEAR
  356.          LOOP
  357.       ENDIF
  358.       DO Clr
  359.       LOOP
  360.    ENDIF
  361.    
  362.    IF Upper(c) = "PICK"
  363.       f1 = SubStr(line,m+1)
  364.       DO Pic 
  365.       LOOP
  366.    ENDIF
  367.    
  368.    IF Upper(c) = "REM"
  369.       LOOP
  370.    ENDIF
  371.    
  372.    IF Upper(c) = "YESNO"
  373.       DO Yn 
  374.       LOOP
  375.    ENDIF
  376.    
  377.    IF Upper(c) = "CHECK"
  378.       DO Chk 
  379.       LOOP
  380.    ENDIF
  381.    
  382.    IF Upper(c) = "DATE"
  383.       DO Dat 
  384.       LOOP
  385.    ENDIF
  386.    
  387.    IF Upper(c) = "QUIT"
  388.       QUIT
  389.    ENDIF
  390. ENDDO
  391. QUIT
  392.  
  393. **************************************************
  394. PROCEDURE Dat
  395. **************************************************
  396.  
  397. DO Gyx WITH y,x
  398. y1 = y
  399. x1 = x
  400. DO Gc WITH b,n,h,bd
  401.  
  402. SELECT a
  403. FLREAD t z line
  404. line = RTrim(CRTrim(line))
  405. s = At("=",line)                              && s=
  406. SEEK SubStr(line,1,s-1)
  407. q = SubStr(line,s+1)                          && q=,=s
  408.  
  409. y2 = y1 + 6
  410. IF Len(q) > 12
  411.    x2 = x1 + Len(q) + 4
  412. ELSE
  413.    x2 = 14
  414. ENDIF
  415.  
  416. SET COLOR TO (b)
  417. DO CASE
  418.    CASE bd = 0
  419.         @ y1+1,x1+1 CLEAR TO y2-1,x2-1
  420.         SET COLOR TO (n)
  421.    CASE bd = 1
  422.         @ y1,x1 CLEAR TO y2,x2
  423.         SET COLOR TO (n)
  424.         @ y1,x1 TO y2,x2
  425.    CASE bd = 2
  426.         @ y1,x1 CLEAR TO y2,x2
  427.         SET COLOR TO (n)
  428.         @ y1,x1 TO y2,x2 DOUBLE
  429. ENDCASE
  430.  
  431. @ y1+2,x1+2 SAY q                             && =q
  432. @ y1+4,x1+2 SAY "Date:"
  433.  
  434. d = CToD("  /  /  ")                          && d=
  435. s = CToD("01/01/10")                          && s=
  436. q = Date() - (365*12)                         && q=
  437.  
  438. SET COLOR TO (h)
  439. DO WHILE .T.
  440.    @ y1+4,x1+8 GET d PICTURE "@D" RANGE s,q    && =q,=s
  441.    READ
  442.    IF UpDated()
  443.       EXIT
  444.    ELSE
  445.       LOOP
  446.    ENDIF
  447. ENDDO
  448.  
  449. SELECT e
  450. f = flg
  451. q = Chr(254 - Day(d))                            && q=
  452. f = Stuff(f,a->fpos,1,q)                         && =q
  453. q = Chr(254 - Month(d))                          && q=
  454. f = Stuff(f,a->fpos+1,1,q)                       && =q
  455. q = Chr(254 - (Year(d) - 1900))                  && q=
  456. f = Stuff(f,a->fpos+2,1,q)                       && =q
  457. REPLACE flg WITH f
  458. k= InKey(1)
  459. RETURN
  460.  
  461. **************************************************
  462. PROCEDURE Pic
  463. **************************************************
  464.  
  465. SELECT a
  466. SEEK f1
  467. IF Found()
  468.    f1 = Homepath() + "PIKS\" + f1 + ".PIK"
  469. ELSE
  470.    DO err WITH 2,f1
  471. ENDIF
  472.  
  473. DO Gyx WITH y,x
  474. y1 = y
  475. x1 = x
  476. DO Gc WITH b,n,h,bd
  477.  
  478. FLREAD t z line
  479. y2 = Val(RTrim(CRTrim(line)))
  480. x2 = x1 + pwidth + 1
  481.  
  482. q = (y2-y1)-1                             && q= Visible # of rows
  483.  
  484. SET COLOR TO (b)
  485. DO CASE
  486.    CASE bd = 0
  487.         @ y1+1,x1+1 CLEAR TO y2-1,x2-1
  488.         SET COLOR TO (n)
  489.    CASE bd = 1
  490.         @ y1,x1 CLEAR TO y2,x2
  491.         SET COLOR TO (n)
  492.         @ y1,x1 TO y2,x2
  493.    CASE bd = 2
  494.         @ y1,x1 CLEAR TO y2,x2
  495.         SET COLOR TO (n)
  496.         @ y1,x1 TO y2,x2 DOUBLE
  497. ENDCASE
  498. m = fMaxLen()                              && m= max buffer size
  499. IF m > 4096
  500.    v = 3072
  501. ELSE
  502.    IF m > 2048                             && max buffer size =m
  503.       v = 1024
  504.    ENDIF
  505. ENDIF
  506. FOPEN p (f1) 10 v
  507.  
  508. s = 1                                         && s= row pointer
  509. DO WHILE .T.
  510.    FLREAD p z line
  511.    line = CRTrim(line)
  512.    @ y1+s,x1+2 SAY line
  513.    IF s = plen .OR. s = q
  514.       EXIT
  515.    ENDIF
  516.    s = s + 1
  517. ENDDO
  518.  
  519. FSEEK p z 0 0
  520. FLREAD p z line
  521. line = CRTrim(line)
  522. w = 1                                      && w= Current line in .PIK file
  523. g = y1 + 1                                 && g= Current row in list
  524.  
  525. SET COLOR TO (h)
  526. @ g,x1+2 SAY line
  527. SET COLOR TO N/N
  528. k = " "
  529. @ 0,0 GET k
  530. DO WHILE .T.
  531.    READ                                          
  532.    DO CASE
  533.       CASE LastKey() = 5
  534.            IF w = 1
  535.               LOOP
  536.            ENDIF
  537.            
  538.            IF g > y1 + 1
  539.               SET COLOR TO (n)
  540.               @ g,x1+2 SAY line
  541.               d = -(pwidth*2)                     && d= Bytes to move
  542.               FSEEK p z d 1                       && Bytes to move =d
  543.               FLREAD p z line
  544.               line = CRTrim(line)
  545.               w = w - 1
  546.               g = g - 1
  547.            ELSE
  548.               SET COLOR TO (n)
  549.               d = -(pwidth*2)                     && d= Bytes to move
  550.               FSEEK p z d 1                       && Bytes to move =d
  551.               s = 1
  552.               DO WHILE .T.  
  553.                  FLREAD p z line
  554.                  line = CRTrim(line)
  555.                  @ y1+s,x1+2 SAY line
  556.                  IF s = q
  557.                     EXIT
  558.                  ENDIF
  559.                  s = s + 1
  560.               ENDDO
  561.               d = (pwidth * (0-q))               && d= Bytes to move
  562.               FSEEK p z d 1                      && Bytes to move =d
  563.               FLREAD p z line
  564.               line = CRTrim(line)
  565.               w = w - 1
  566.            ENDIF   
  567.            
  568.       CASE LastKey() = 13                    
  569.            IF flen = 1
  570.               w = Chr(254-w)
  571.            ELSE
  572.               g = Ceiling(w/126)                 && g= Flag @ fpos 1
  573.               g = Chr(254-g)
  574.               z = Int(w/126)
  575.               w = w - (126 * z)
  576.               w = Chr(254 - w)
  577.               w = g + w                          && Flag @ fpos 1 =g
  578.            ENDIF
  579.            
  580.            SELECT e
  581.            f = flg
  582.            SET COLOR TO W+/N
  583.            f = Stuff(f,a->fpos,a->flen,w)
  584.            REPLACE flg WITH f
  585.            FCLOSE p
  586.            RETURN
  587.  
  588.       CASE LastKey() = 24                    
  589.            SET COLOR TO W+/N
  590.            IF w = plen 
  591.               LOOP
  592.            ENDIF
  593.            IF g < q + y1
  594.               SET COLOR TO (n)
  595.               @ g,x1+2 SAY line
  596.               FLREAD p z line                
  597.               line = CRTrim(line)
  598.               w = w + 1
  599.               g = g + 1                       && Current row in list =g
  600.            ELSE
  601.               SET COLOR TO (n)
  602.               d = (pwidth * (1-q))            && d= Bytes to move
  603.               FSEEK p z d 1                   && Bytes to move =d
  604.               s = 1
  605.               DO WHILE .T.                   
  606.                  FLREAD p z line
  607.                  line = CRTrim(line)
  608.                  @ y1+s,x1+2 SAY line
  609.                  IF s = q                      && Visible # of rows =q
  610.                     EXIT
  611.                  ENDIF
  612.                  s = s + 1                     &&  row pointer =s
  613.               ENDDO
  614.               w = w + 1                      && Current line in .PIK file =w
  615.            ENDIF   
  616.    ENDCASE
  617. SET COLOR TO (h)
  618. @ g,x1+2 SAY line
  619. ENDDO
  620. RETURN
  621.  
  622.  
  623. **************************************************      
  624. PROCEDURE Clr      
  625. **************************************************            
  626.  
  627. DO Gyx WITH y,x
  628. y1 = y
  629. x1 = x
  630. DO Gyx WITH y,x
  631. y2 = y
  632. x2 = x
  633.  
  634. FLREAD t z line
  635. line = RTrim(CRTrim(line))
  636. s = At(",",line)                 && s= At ","
  637. n = SubStr(line,1,s-1)
  638. b = SubStr(n,Len(n),1)
  639. b = b + "/" + b
  640. bd = Val(SubStr(line,s+1))      && At "," =s
  641.  
  642. SET COLOR TO (b)
  643. @ y1,x1 CLEAR TO y2,x2
  644. SET COLOR TO (n)
  645. DO CASE
  646.    CASE bd = 1
  647.         @ y1,x1 TO y2,x2
  648.    CASE bd = 2
  649.         @ y1,x1 TO y2,x2 DOUBLE
  650. ENDCASE
  651.  
  652. RETURN
  653.  
  654. **************************************************
  655. PROCEDURE Yn      q has value throughout
  656. **************************************************
  657.  
  658. DO Gyx WITH y,x
  659. y1 = y
  660. x1 = x
  661. x2 = 79 - x1
  662.  
  663. DO Gc WITH b,n,h,bd
  664.  
  665. FLREAD t z line
  666. line = RTrim(CRTrim(line))
  667. d = At("/",line)                                  && d=
  668. y = " " + SubStr(line,1,d-1) + " "               && y= "Yes" string
  669. w = " " + SubStr(line,d+1) + " "                 && =d,w= "No" string
  670.  
  671. d = x1 + 2                                        && d=
  672. s = x2 - (2 + Len(w))                            && s=
  673.  
  674. SET COLOR TO (h)
  675. @ y1,d SAY y
  676. SET COLOR TO (n)
  677. @ y1,s SAY w
  678.    
  679. x = 1
  680. SET COLOR TO N/N
  681. k = " "
  682. @ 0,0 GET k
  683.    
  684. DO WHILE .T.
  685.    READ                                          
  686.    DO CASE
  687.    CASE LastKey() = 4 
  688.               IF x = 2
  689.                  LOOP
  690.               ELSE
  691.                  SET COLOR TO (n)
  692.                  @ y1,d SAY y
  693.                  SET COLOR TO (h)
  694.                  @ y1,s SAY w
  695.                  x = 2
  696.               ENDIF
  697.               
  698.          CASE LastKey() = 19
  699.               IF x = 1
  700.                  LOOP
  701.               ELSE
  702.                  SET COLOR TO (n)
  703.                  @ y1,s SAY w                 && =s, "No" string =w
  704.                  SET COLOR TO (h)
  705.                  @ y1,d SAY y                  && =d
  706.                  x = 1
  707.               ENDIF
  708.               
  709.          CASE LastKey() = 13                    
  710.               SELECT e
  711.               IF x = 1
  712.                  REPLACE ysn WITH .T.
  713.               ELSE 
  714.                  REPLACE ysn WITH .F.
  715.               ENDIF
  716.               RETURN
  717.       ENDCASE
  718.    ENDDO
  719. RETURN
  720.  
  721. **************************************************
  722. PROCEDURE Gc
  723. **************************************************
  724. PARAMETERS b,n,h,bd
  725.  
  726. FLREAD t z line
  727. line = RTrim(CRTrim(line))
  728. s = At(",",line)                 && s= At ","
  729. n = SubStr(line,1,s-1)
  730. b = SubStr(n,Len(n),1)
  731. b = b + "/" + b
  732. line = SubStr(line,s+1)      && At "," =s
  733. s = At(",",line)
  734. h = SubStr(line,1,s-1)
  735. bd = Val(SubStr(line,s+1))
  736. RETURN
  737.  
  738. **************************************************
  739. PROCEDURE Gyx
  740. **************************************************
  741. PARAMETERS y,x
  742.  
  743. FLREAD t z line
  744. line = RTrim(CRTrim(line))
  745. s = At(",",line)                   && s= At ","
  746. y = Val(SubStr(line,1,s-1))
  747. line = SubStr(line,s+1)
  748. s = At(",",line)
  749. x = Val(SubStr(line,1,s-1))        && At "," =s
  750. RETURN
  751.  
  752. **************************************************
  753. PROCEDURE Vew     q has value throughout
  754. **************************************************
  755.  
  756. DO Gc WITH b,n,h,bd
  757.  
  758. SELECT a
  759. g = 0                                        && g= bytes to move back
  760. x = 0
  761. DO WHILE .T.
  762.    FLREAD t z line
  763.    line = RTrim(CRTrim(line))
  764.    g = g - z
  765.    IF Len(line) < 3 .OR. .NOT. "=" $ line .OR. ":" $ line
  766.       EXIT
  767.    ENDIF
  768.    x = x + 1
  769. ENDDO
  770. y = x                                      && y= number of items to view
  771.  
  772. FSEEK t z g 1                              && bytes to move back =g
  773.  
  774. DECLARE pf[x]
  775. DECLARE tit[x]
  776.  
  777. s = 0                                            && s= Max length of pwidth
  778. g = 0                                            && g= Max length of title
  779. x = 1
  780. DO WHILE x <= y
  781.    FLREAD t z line
  782.    line = RTrim(CRTrim(line))
  783.    w = At("=",line)                               && w= position of "="
  784.    pf[x] = SubStr(line,1,w-1)                     
  785.    tit[x] = SubStr(line,w+1)                      &&  position of "="  =w
  786.    SEEK pf[x]
  787.    IF .NOT. Found()
  788.       DO err WITH 5,x
  789.    ENDIF
  790.    IF pwidth > s
  791.       s = pwidth
  792.    ENDIF
  793.    IF Len(tit[x]) > g
  794.       g = Len(tit[x])
  795.    ENDIF
  796.    x1 = s + g                                    && Max length of pwidth =s
  797.    IF x1 > 74
  798.       DO err WITH 6,x
  799.    ENDIF
  800.    x = x + 1
  801. ENDDO
  802.  
  803. DO CASE
  804.    CASE y <= 12 
  805.         x2 = Max(x1,44) + 6
  806.         y1 = Ceiling((23 - (y + 8))/2)
  807.         y2 = y1 + 7 + y
  808.         x1 = Ceiling((79 - x2)/2) 
  809.         x2 = x1 + x2
  810.         SET COLOR TO (b)
  811.         @ y1,x1 CLEAR TO y2,x2
  812.         SET COLOR TO (n)
  813.         @ y1,x1 TO y2,x2
  814.         @ y1+2,x1 SAY "├" 
  815.         @ y1+2,x1+1 TO y1+2,x2-1
  816.         @ y1+2,x2 SAY "┤"
  817.         @ y2-2,x1 SAY "├" 
  818.         @ y2-2,x1+1 TO y2-2,x2-1
  819.         @ y2-2,x2 SAY "┤"
  820.         IF q = "A"
  821.            SET COLOR TO (h)
  822.            @ y2-1,x1+2 SAY "<N>" 
  823.            @ y2-1,36 SAY "<Q>"
  824.            SET COLOR TO (n)
  825.            @ y2-1,x1+6 SAY "Next" 
  826.            @ y2-1,40 SAY "Quit" 
  827.         ELSE
  828.            SET COLOR TO (h)
  829.            @ y2-1,36 SAY "<Q>"
  830.            SET COLOR TO (n)
  831.            @ y2-1,40 SAY "Quit" 
  832.         ENDIF
  833.         
  834.         x = 1
  835.         DO WHILE x <= y
  836.            @ y1+3+x,x1+2  SAY tit[x]
  837.            @ y1+3+x,Col() SAY ":"
  838.            x = x + 1
  839.         ENDDO
  840.         
  841.    OTHERWISE
  842.         DO err WITH 3,x
  843. ENDCASE
  844.  
  845. SELECT e
  846.  
  847. IF q = "A"
  848.    SET FILTER TO vis
  849.    COUNT TO w                      && w= Number of users
  850.    GOTO TOP
  851.    IF w = 0
  852.       DO Err WITH 4,1
  853.    ENDIF
  854. ENDIF
  855.  
  856. SET COLOR TO (h)
  857. @ y1+1,x1+10 SAY usr
  858. SELECT a
  859.  
  860. x = 1
  861. DO WHILE x <= y
  862.    SEEK pf[x]
  863.    IF flen < 3
  864.       IF flen = 1
  865.          f = 254 - Asc(SubStr(e->flg,fpos,1))
  866.       ELSE
  867.          d = SubStr(e->flg,fpos,1)                    && d= 
  868.          d = ((254 - Asc(d))-1) * 126                   
  869.          f = SubStr(e->flg,fpos+1,1)
  870.          f = 254-Asc(f)
  871.          f = d + f                                      && =d 
  872.       ENDIF   
  873.       d = (f * pwidth) - pwidth                         && d= 
  874.       tit[x] = Homepath() + "PIKS\" + RTrim(pf[x]) + ".PIK"  && d= file name
  875.       FOPEN s (tit[x]) 10 v
  876.       FSEEK s z d 0                                   && =d 
  877.       FLREAD s z line
  878.       FCLOSE s
  879.    ELSE   
  880.       line = LTrim(Str(254-Asc(SubStr(e->flg,fpos,1))))
  881.       d = LTrim(Str(254-Asc(SubStr(e->flg,fpos+1,1))))    && d= 
  882.       f = LTrim(Str(254-Asc(SubStr(e->flg,fpos+2,1))))
  883.       line = line + "/" + d + "/" + f                       && =d 
  884.    ENDIF
  885.    @ y1+3+x,x1+g+4 SAY line                    && Max length of title =g
  886.    x = x + 1
  887. ENDDO
  888.  
  889. IF q = "A" 
  890.    SET COLOR TO (b)
  891.    j = 3
  892.    i = 1
  893.    k = " "
  894.    @ y1+1,x1+1 GET k
  895.    DO WHILE .T.
  896.       READ                                          
  897.       DO CASE
  898.          CASE LastKey() = 78 .OR.  LastKey() = 110        && next
  899.               IF i = w
  900.                  LOOP
  901.               ENDIF
  902.               IF j = 3                        && No previous
  903.                  SET COLOR TO (h)
  904.                  @ y2-1,x2-13 SAY "<P>"  
  905.                  SET COLOR TO (n)
  906.                  @ y2-1,x2-9 SAY "Previous"  
  907.                  j = 2
  908.               ENDIF
  909.               SELECT e
  910.               SKIP
  911.               SET COLOR TO (h)
  912.               @ y1+1,x1+10 SAY usr
  913.               SELECT a
  914.               x = 1
  915.               DO WHILE x <= y
  916.                  SEEK pf[x]
  917.                  IF flen < 3
  918.                     IF flen = 1
  919.                        f = 254 - Asc(SubStr(e->flg,fpos,1))
  920.                     ELSE
  921.                        d = SubStr(e->flg,fpos,1)                    && d= 
  922.                        d = ((254 - Asc(d))-1) * 126                   
  923.                        f = SubStr(e->flg,fpos+1,1)
  924.                        f = 254 - Asc(f)
  925.                        f = d + f                                      && =d 
  926.                     ENDIF   
  927.                     d = (f * pwidth) - pwidth                         && d= 
  928.                     FOPEN s (tit[x]) 10 v
  929.                     FSEEK s z d 0                                   && =d 
  930.                     FLREAD s z line
  931.                     FCLOSE s
  932.                  ELSE   
  933.                     line = LTrim(Str(254-Asc(SubStr(e->flg,fpos,1))))
  934.                     d = LTrim(Str(254-Asc(SubStr(e->flg,fpos+1,1))))    && d= 
  935.                     f = LTrim(Str(254-Asc(SubStr(e->flg,fpos+2,1))))
  936.                     line = line + "/" + d + "/" + f                       && =d 
  937.                  ENDIF
  938.                  @ y1+3+x,x1+g+4 SAY line                    && Max length of title =g
  939.                  x = x + 1
  940.               ENDDO
  941.               i = i + 1
  942.               IF j # 1 .AND. i = w 
  943.                  SET COLOR TO (b)
  944.                  @ y2-1,x1+2 SAY "        "
  945.                  j = 1            
  946.               ENDIF
  947.               
  948.          CASE LastKey() = 80 .OR.  LastKey() = 112        && previous
  949.               IF i = 1
  950.                  LOOP
  951.               ENDIF
  952.               IF j = 1
  953.                  SET COLOR TO (h)
  954.                  @ y2-1,x1+2 SAY "<N>" 
  955.                  SET COLOR TO (n)
  956.                  @ y2-1,x1+6 SAY "Next" 
  957.                  j = 2                         && Previous and Next
  958.               ENDIF
  959.  
  960.               SELECT e
  961.               SKIP -1
  962.               SET COLOR TO (h)
  963.               @ y1+1,x1+10 SAY usr
  964.               SELECT a
  965.               x = 1
  966.               DO WHILE x <= y
  967.                  SEEK pf[x]
  968.                  IF flen < 3
  969.                     IF flen = 1
  970.                        f = 254 - Asc(SubStr(e->flg,fpos,1))
  971.                     ELSE
  972.                        d = SubStr(e->flg,fpos,1)                    && d= 
  973.                        d = ((254 - Asc(d))-1) * 126                   
  974.                        f = SubStr(e->flg,fpos+1,1)
  975.                        f = 254 - Asc(f)
  976.                        f = d + f                                      && =d 
  977.                     ENDIF   
  978.                     d = (f * pwidth) - pwidth                         && d= 
  979.                     FOPEN s (tit[x]) 10 v
  980.                     FSEEK s z d 0                                   && =d 
  981.                     FLREAD s z line
  982.                     FCLOSE s
  983.                  ELSE   
  984.                     line = LTrim(Str(254-Asc(SubStr(e->flg,fpos,1))))
  985.                     d = LTrim(Str(254-Asc(SubStr(e->flg,fpos+1,1))))    && d= 
  986.                     f = LTrim(Str(254-Asc(SubStr(e->flg,fpos+2,1))))
  987.                     line = line + "/" + d + "/" + f                       && =d 
  988.                  ENDIF
  989.                  @ y1+3+x,x1+g+4 SAY line                    && Max length of title =g
  990.                  x = x + 1
  991.               ENDDO
  992.               
  993.               i = i - 1
  994.               IF j # 3 .AND. i = 1
  995.                  SET COLOR TO (b)
  996.                  @ y2-1,x2-13 SAY "            "
  997.                  j = 3  
  998.               ENDIF
  999.               
  1000.          CASE LastKey() = 81 .OR.  LastKey() = 113        && quit
  1001.               EXIT
  1002.       ENDCASE
  1003.    ENDDO
  1004. ELSE
  1005.    SET COLOR TO (b)
  1006.    k = " "
  1007.    @ y1+1,x1+1 GET k
  1008.    DO WHILE .T.
  1009.       READ                                          
  1010.       IF LastKey() = 81 .OR.  LastKey() = 113        && quit
  1011.          EXIT
  1012.       ENDIF
  1013.    ENDDO
  1014. ENDIF
  1015. RELEASE tit
  1016. RELEASE pf
  1017. RETURN
  1018.  
  1019. **************************************************
  1020. PROCEDURE err
  1021. PARAMETERS q,d
  1022.  
  1023. DO CASE
  1024.    CASE q = 1
  1025.         s = "No ENDIF: after IF:"
  1026.    CASE q = 2
  1027.         s = "File " + d + " not found."
  1028.    CASE q = 3
  1029.         s = LTrim(Str(d)) + " items in view. Maximum number of 12 items/view."
  1030.    CASE q = 4
  1031.         s = "No users on system visible."
  1032.    CASE q = 5           
  1033.         s = "View item # " + LTrim(Str(d)) + " could not be found."
  1034.    CASE q = 6           
  1035.         s = "Length of title and field in view, line "+ LTrim(Str(d)) + " cannot exceed 70."
  1036. ENDCASE
  1037. SET COLOR TO W+/N
  1038. @ 5,5 SAY s
  1039. @ 6,5 SAY "Program terminating. Please notify Sysop."
  1040. @ 7,15 SAY "<ANY KEY>"
  1041. k = InKey (0)
  1042. QUIT
  1043.  
  1044. RETURN
  1045.  
  1046. **************************************************
  1047. PROCEDURE er
  1048.  
  1049. SET COLOR TO N/N
  1050. @ 0,0 CLEAR
  1051. line = Message()
  1052. SET COLOR TO W+/N
  1053. @ 5,5 SAY line
  1054. @ 6,5 SAY "Program terminating. Please notify Sysop."
  1055. @ 7,15 SAY "<ANY KEY>"
  1056. k = InKey(0)
  1057. QUIT
  1058. RETURN
  1059.  
  1060.  
  1061. **************************************************
  1062. PROCEDURE Gfld
  1063. PARAMETERS s,o
  1064.  
  1065. o = .F.
  1066.  
  1067. q = SubStr(line,1,3)
  1068.  
  1069. DO CASE
  1070.    CASE Upper(q) = "YSN"
  1071.         IF s=1 
  1072.            IF YSN
  1073.               o = .T.
  1074.            ENDIF
  1075.         ELSE
  1076.            IF .NOT. YSN
  1077.               o = .T.
  1078.            ENDIF
  1079.         ENDIF
  1080.    
  1081.    CASE Upper(q) = "REG"
  1082.         IF s=1 
  1083.            IF REG
  1084.               o = .T.
  1085.            ENDIF
  1086.         ELSE
  1087.            IF .NOT. REG
  1088.               o = .T.
  1089.            ENDIF
  1090.         ENDIF
  1091.    
  1092.    CASE Upper(q) = "AGE"
  1093.         IF s=1 
  1094.            IF AGE
  1095.               o = .T.
  1096.            ENDIF
  1097.         ELSE
  1098.            IF .NOT. AGE
  1099.               o = .T.
  1100.            ENDIF
  1101.         ENDIF
  1102.    
  1103.    CASE Upper(q) = "VIS"
  1104.         IF s=1 
  1105.            IF VIS
  1106.               o = .T.
  1107.            ENDIF
  1108.         ELSE
  1109.            IF .NOT. VIS
  1110.               o = .T.
  1111.            ENDIF
  1112.         ENDIF
  1113. ENDCASE
  1114. RETURN
  1115.  
  1116. **************************************************
  1117. PROCEDURE Cfld
  1118. PARAMETERS s
  1119.  
  1120. q = SubStr(line,1,3)
  1121.  
  1122. DO CASE
  1123.    CASE Upper(q) = "YSN"
  1124.         IF s=1 
  1125.            REPLACE ysn WITH .T.
  1126.         ELSE
  1127.            REPLACE ysn WITH .F.
  1128.         ENDIF
  1129.    
  1130.    CASE Upper(q) = "REG"
  1131.         IF s=1 
  1132.            REPLACE reg WITH .T.
  1133.         ELSE
  1134.            REPLACE reg WITH .F.
  1135.         ENDIF
  1136.    
  1137.    CASE Upper(q) = "AGE"
  1138.         IF s=1 
  1139.            REPLACE age WITH .T.
  1140.         ELSE
  1141.            REPLACE age WITH .F.
  1142.         ENDIF
  1143.    
  1144.    CASE Upper(q) = "VIS"
  1145.         IF s=1 
  1146.            REPLACE vis WITH .T.
  1147.         ELSE
  1148.            REPLACE vis WITH .F.
  1149.         ENDIF
  1150. ENDCASE
  1151. RETURN
  1152.  
  1153. **************************************************
  1154. PROCEDURE Chk
  1155.  
  1156. d = Val(SubStr(line,m+1))                       && d= Box style
  1157.  
  1158. DO CASE 
  1159.    CASE d = 1
  1160.         i = "( )"
  1161.         q = "(∙)"
  1162.    CASE d = 2
  1163.         i = "[ ]"
  1164.         q = "[X]"
  1165.    CASE d = 3
  1166.         i = "< >"
  1167.         q = "<■>"
  1168. ENDCASE
  1169.  
  1170. DO Gyx WITH y,x
  1171. y1 = y
  1172. x1 = x
  1173.  
  1174. DO Gc WITH b,n,h,bd
  1175.  
  1176. g = 0                                        && g= bytes to move back
  1177. x = 0
  1178. DO WHILE .T.
  1179.    FLREAD t z line
  1180.    line = RTrim(CRTrim(line))
  1181.    g = g - z
  1182.    IF Len(line) < 3 .OR. .NOT. "=" $ line
  1183.       EXIT
  1184.    ENDIF
  1185.    x = x + 1
  1186. ENDDO
  1187. y = x +1                                   && y= number of items to view
  1188.  
  1189. FSEEK t z g 1                              && bytes to move back =g
  1190.  
  1191. DECLARE pf[y]
  1192. DECLARE tit[y]
  1193.  
  1194. f= flg
  1195.  
  1196. g = 4                                            && g= Max length of title
  1197. x = 1
  1198. DO WHILE x <= y-1
  1199.    FLREAD t z line
  1200.    line = RTrim(CRTrim(line))
  1201.    w = At("=",line)                               && w= position of "="
  1202.    pf[x] = Val(SubStr(line,1,w-1))                && flag position
  1203.    f = Stuff(f,pf[x],1,"n")
  1204.    tit[x] = SubStr(line,w+1)                      &&  position of "="  =w
  1205.    IF Len(tit[x]) > g
  1206.       g = Len(tit[x])
  1207.    ENDIF
  1208.    x = x + 1
  1209. ENDDO
  1210. pf[y] = 0
  1211. tit[y] = "Quit"
  1212.  
  1213. y2 = y1 + y + 3
  1214. x2 = x1 + g + 6
  1215.  
  1216. SET COLOR TO (b)
  1217. DO CASE
  1218.    CASE bd = 0
  1219.         @ y1+1,x1+1 CLEAR TO y2-1,x2-1
  1220.         SET COLOR TO (n)
  1221.    CASE bd = 1
  1222.         @ y1,x1 CLEAR TO y2,x2
  1223.         SET COLOR TO (n)
  1224.         @ y1,x1 TO y2,x2
  1225.    CASE bd = 2
  1226.         @ y1,x1 CLEAR TO y2,x2
  1227.         SET COLOR TO (n)
  1228.         @ y1,x1 TO y2,x2 DOUBLE
  1229. ENDCASE
  1230.  
  1231.  
  1232. x = 1
  1233. DO WHILE x <= y-1
  1234.    IF SubStr(f,pf[x],1) = "n"
  1235.       @ y1+1+x,x1+2 SAY i
  1236.    ELSE
  1237.       @ y1+1+x,x1+2 SAY q
  1238.    ENDIF
  1239.    @ y1+1+x,x1+6 SAY tit[x]
  1240.    x = x + 1
  1241. ENDDO
  1242.  
  1243. @ y1+1+y,x1+2 SAY i
  1244. @ y1+1+y,x1+6 SAY "Quit"
  1245.  
  1246. x = 1
  1247. SET COLOR TO (h)
  1248. @ y1+1+x,x1+6 SAY tit[x]
  1249.  
  1250. SET COLOR TO N/N
  1251. k = " "
  1252. @ 0,0 GET k
  1253.    
  1254. DO WHILE .T.
  1255.    READ                                          
  1256.    DO CASE
  1257.       CASE LastKey() = 5 
  1258.            IF x = 1
  1259.               LOOP
  1260.            ELSE
  1261.               SET COLOR TO (n)
  1262.               @ y1+1+x,x1+6 SAY tit[x]
  1263.               x = x - 1
  1264.               SET COLOR TO (h)
  1265.               @ y1+1+x,x1+6 SAY tit[x]
  1266.            ENDIF
  1267.               
  1268.       CASE LastKey() = 24
  1269.            IF x = y
  1270.               LOOP
  1271.            ELSE
  1272.               SET COLOR TO (n)
  1273.               @ y1+1+x,x1+6 SAY tit[x]
  1274.               x = x + 1
  1275.               SET COLOR TO (h)
  1276.               @ y1+1+x,x1+6 SAY tit[x]
  1277.            ENDIF
  1278.               
  1279.       CASE LastKey() = 32                    
  1280.            SET COLOR TO (n)
  1281.            IF x = y
  1282.               @ y1+1+x,x1+2 SAY q
  1283.               RELEASE tit
  1284.               RELEASE pf
  1285.               k = InKey(1)
  1286.               RETURN
  1287.            ENDIF
  1288.            SELECT e
  1289.            IF SubStr(f,pf[x],1) = "n"
  1290.               f = Stuff(f,pf[x],1,"y")
  1291.               REPLACE flg WITH f
  1292.               @ y1+1+x,x1+2 SAY q
  1293.            ELSE 
  1294.               f = Stuff(f,pf[x],1,"n")
  1295.               REPLACE flg WITH f
  1296.               @ y1+1+x,x1+2 SAY i
  1297.            ENDIF
  1298.         
  1299.    ENDCASE
  1300. ENDDO
  1301. RETURN
  1302.  
  1303.  
  1304.